home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / graphics / shadow20.arj / SHADOWBX.BAS < prev    next >
BASIC Source File  |  1993-12-10  |  7KB  |  299 lines
  1. '******************************SHADOW2.BAS*******************************
  2. '
  3. 'Wow!! You guys, what complainers! First I give you a real true-blue
  4. 'shadow box and now you complain that you have to exit the program each
  5. 'time, "why can't I see other backgrounds with the shadow," "Why did you
  6. 'print the character, you didn't need to do that" et cetera, et cetera
  7. 'and more et ceteras.
  8. '
  9. 'So, this is SHADOW2.BAS and answers -most- of the complaints.
  10. '12/9/93
  11. '
  12. 'Oh...oh... almost forgot; now there are lots more SUBs and FUNCTIONS
  13. 'as I was reading Ethan Winer's book "BASIC Techniques and Utilities,"
  14. 'PC Magazine Ziff-Davis Press; 1991 and used several (many?) of
  15. 'Ethan's ideas on LOCATE and COLOR.
  16.  
  17. '===================================================================
  18. 'PREAMBLE to original (not so brilliant) SHADOWBX.BAS follows...
  19. '
  20. 'JRD NOTE: This works.
  21. 'Can now make a real shadowed box as the characters in the shadow
  22. 'are reprinted to the screen in the shaded color
  23. 'coooool
  24. '12/6/93                             
  25. '                           
  26. 'The box shape
  27. '                               █▀▀▀▀▀▀█                                                    
  28. '                               █      █                                          
  29. '                               █▄▄▄▄▄▄█                                                    
  30. '
  31. '
  32. 'declarations, SUBs and FUNCTIONS
  33.  
  34. CONST False = 0, True = NOT False
  35.  
  36. DECLARE FUNCTION IntPeek% (Address%)
  37. DECLARE FUNCTION ReturnKey$ ()
  38.  
  39. DECLARE SUB CursorOn ()
  40. DECLARE SUB CursorOff ()
  41. DECLARE SUB Pause (Seconds%)
  42. DECLARE SUB WaitKey ()
  43. DECLARE SUB LocateIt (Row%, text$)
  44. DECLARE SUB ColorIt (Fgd%, Bkgd%)
  45. DECLARE SUB Mono (Flag%)
  46. DECLARE SUB Shadowbox (top%, Bottom%, Wide%, BoxColr%, Fgd%, Bkgd%)
  47. DECLARE SUB PokeColor (Address%, Colr%)
  48. DECLARE SUB IntPoke (Address%, Value%)
  49.  
  50. 'executable code starts here
  51. DEF FNCenterit% (text$) = 41 - (LEN(text$) \ 2)
  52. DEFINT A-Z
  53. SCREEN 0
  54. WIDTH 80
  55. COLOR 15, 1
  56. CLS
  57. CALL Mono(Flag%)
  58. 'Flag% = True
  59.  
  60. IF Flag% THEN
  61.     CALL ColorIt(0, 7)
  62.     CLS
  63.     text$ = "Oops.... Can't run this with a monochrome monitor"
  64.     CALL LocateIt(10, text$)
  65.     text$ = "Because all I can test is COLOR. Sorry... Press <Esc> to END"
  66.     CALL LocateIt(12, text$)
  67.     text$ = " "
  68.     CursorOn
  69.     CALL LocateIt(14, text$)
  70.     IF ReturnKey$ = CHR$(27) THEN
  71.         CursorOff
  72.         END
  73.     END IF
  74. END IF
  75.  
  76. count = 1
  77.  
  78. DEF SEG = &HB800                'got to have this or big crash!
  79.  
  80. Again:
  81.  
  82. CALL ColorIt(15, 1)
  83. CLS
  84. 'STOP
  85. SELECT CASE count
  86.     CASE 1
  87.         Char% = 96
  88.         FOR X% = 1 TO 24
  89.             PRINT STRING$(80, X% + Char%);
  90.         NEXT
  91.     CASE 2
  92.         Char% = 64
  93.         FOR X% = 1 TO 24
  94.             PRINT STRING$(80, X% + Char%);
  95.         NEXT
  96.     CASE 3 TO 21
  97.         Char% = 173 + count
  98.         FOR X% = 1 TO 24
  99.             PRINT STRING$(80, Char%);
  100.         NEXT
  101.     CASE 22
  102.         count = 1
  103.         GOTO Again
  104.     CASE ELSE
  105.         PRINT "We got a BIG ERROR!!!"
  106.         BEEP
  107.         END
  108. END SELECT
  109.  
  110. text$ = " Enter box Size and color with commas between the numbers "
  111. CALL ColorIt(11, 0)
  112. CALL LocateIt(1, text$)
  113.  
  114. text$ = "   top%, Bottom%, Wide%, boxcolr%, fgd%, bkgd%   "
  115. CALL ColorIt(15, 4)
  116. CALL LocateIt(2, text$)
  117.  
  118. text$ = SPACE$(18)
  119. CALL ColorIt(7, 0)
  120. CALL LocateIt(3, text$)
  121.  
  122. LOCATE 3, FNCenterit%(text$)
  123. CursorOn
  124. INPUT "", top%, Bottom%, Wide%, BoxColr%, Fgd%, Bkgd%
  125. CursorOff
  126. CALL Shadowbox(top%, Bottom%, Wide%, BoxColr%, Fgd%, Bkgd%)
  127.  
  128. CALL Pause(5)
  129.  
  130. text$ = " PRESS 'Y' to try another BACKGROUND and box dimensions..."
  131. CALL ColorIt(15, 0)
  132. CALL LocateIt(12, text$)
  133.  
  134. text$ = "  "
  135. CursorOn
  136. CALL LocateIt(14, text$)
  137. LOCATE 14, FNCenterit(text$)
  138. IF UCASE$(ReturnKey$) = "Y" THEN
  139.     count = count + 1
  140.     GOTO Again
  141. ELSE
  142.     CursorOff
  143.     top% = 14: Bottom% = 22: Wide% = 44: BoxColr% = 4: Fgd% = 15: Bkdg% = 2
  144.     CALL Shadowbox(top%, Bottom%, Wide%, BoxColr%, Fgd%, Bkgd%)
  145.     text$ = "Hope you liked this little demo..."
  146.     CALL ColorIt(14, 4)
  147.     CALL LocateIt(16, text$)
  148.     text$ = "John De Palma on CompuServe 76076,571"
  149.     CALL ColorIt(15, 4)
  150.     CALL LocateIt(18, text$)
  151.    
  152.     BEEP
  153.     Pause (5)
  154.     CALL ColorIt(7, 0)
  155. END IF
  156.  
  157. SUB ColorIt (Fgd%, Bkgd%)
  158. COLOR Fgd%, Bkgd%
  159. END SUB
  160.  
  161. SUB CursorOff
  162. LOCATE , , 0
  163. END SUB
  164.  
  165. SUB CursorOn
  166. LOCATE , , 1, 4, 7
  167. END SUB
  168.  
  169. 'not used, but left it in as it is hard to find this function
  170. FUNCTION IntPeek% (Address%)
  171. IntPeek% = PEEK(Address%) + PEEK((Address% + 1) * 256)
  172. END FUNCTION
  173.  
  174. SUB IntPoke (Address%, Value%)
  175. 'not used, left it in, hard to find pokes an integer.
  176. 'the next two statements poke an integer
  177. POKE Address%, Value% AND 255
  178. POKE Address% + 1, Value% \ 256
  179. END SUB
  180.  
  181. SUB LocateIt (Row%, text$)
  182. LOCATE Row%, FNCenterit(text$)
  183. PRINT text$;
  184. END SUB
  185.  
  186. SUB Mono (Flag%)
  187. IF PEEK(&H463) = &H4B THEN
  188.     'we got a monochrome screen
  189.     Flag% = True
  190. ELSE
  191.     'we gots color
  192.     Flag% = False
  193. END IF
  194. END SUB
  195.  
  196. SUB Pause (Seconds%)
  197. Start! = TIMER
  198. EndTime! = Start! + Seconds%
  199. DO
  200. Kee$ = INKEY$
  201. LOOP UNTIL TIMER > EndTime! OR LEN(Kee$)
  202. END SUB
  203.  
  204. SUB PokeColor (Address%, Colr%)
  205. 'POKE Address%, Character%
  206. POKE Address% + 1, Colr%
  207. END SUB
  208.  
  209. FUNCTION ReturnKey$
  210. WHILE INKEY$ <> "": WEND
  211. DO
  212. Kee$ = INKEY$
  213. LOOP UNTIL LEN(Kee$)
  214. ReturnKey$ = Kee$
  215. END FUNCTION
  216.  
  217. SUB Shadowbox (top%, Bottom%, Wide%, BoxColr%, Fgd%, Bkgd%)
  218.  
  219. REDIM box$(3)
  220. box$(1) = "█"
  221.  
  222. box$(2) = "▀"
  223. box$(3) = "▄"
  224.  
  225.  
  226. 'this sets the colors
  227.   COLOR Fgd%, Bkgd%
  228.     Left% = (80 - Wide%) \ 2
  229.     right% = Left% + Wide%
  230.     middle% = right% - Left%
  231.     rows% = top%
  232.  
  233.     boxtop% = Wide% - 1
  234.  
  235. 'this prints the box and sets the background color of the box
  236. 'if you use a zero, you get a transparent box
  237. IF BoxColr% = 0 THEN GOTO MakeBox
  238.         COLOR , BoxColr%
  239.  
  240.         FOR boxsize% = top% TO Bottom%
  241.                 LOCATE rows%, Left%, 0
  242.                 PRINT SPACE$(middle%);
  243.                 rows% = rows% + 1
  244.         NEXT
  245.  
  246. 'this prints the box outline
  247.  
  248. MakeBox:
  249.                 LOCATE top%, Left%
  250.                 COLOR Fgd%, Bkgd%
  251.                 PRINT box$(1); STRING$(boxtop%, box$(2)); box$(1);
  252.                 FOR rows% = top% + 1 TO Bottom% - 1
  253.                         LOCATE rows%, Left%
  254.                         PRINT box$(1);
  255.                         LOCATE rows%, right%
  256.                         PRINT box$(1);
  257.                 NEXT rows%
  258.                 LOCATE Bottom%, Left%
  259.                 PRINT box$(1); STRING$(boxtop%, box$(3)); box$(1);
  260. 'STOP
  261.  
  262. 'Now the shadow
  263.  
  264. foregd = 7
  265. Backgd = 0
  266.  
  267. 'use the simple color formula
  268. Colr% = foregd + (16 * Backgd)
  269. 'prints the bottom
  270. FOR i = 0 TO Wide%
  271. 'from QuickBASIC Bible, p 715
  272. offset% = (Bottom%) * 160 + (Left% + i) * 2
  273. Character% = PEEK(offset%)
  274. CALL PokeColor(offset%, Colr%)
  275. NEXT i
  276. 'STOP
  277. 'prints the right side
  278. FOR i = top% TO Bottom%
  279. offset% = (i) * 160 + (right%) * 2
  280. Character% = PEEK(offset%)
  281. CALL PokeColor(offset%, Colr%)
  282. offset% = (i) * 160 + (right% + 1) * 2
  283. Character% = PEEK(offset%)
  284. CALL PokeColor(offset%, Colr%)
  285.  
  286. NEXT
  287. 'STOP
  288.  
  289. END SUB
  290.  
  291. SUB WaitKey
  292. WHILE INKEY$ <> "": WEND
  293. DO
  294. Kee$ = INKEY$
  295. LOOP UNTIL LEN(Kee$)
  296. IF Kee$ = CHR$(27) THEN END
  297. END SUB
  298.  
  299.